; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.

; This is file arch.scm.

;;;; Architecture description

(define architecture-version "Vanilla 40")

; Things that the VM and the runtime system both need to know.

(define bits-used-per-byte bits-per-byte)

(define byte-limit (expt 2 bits-used-per-byte))
(define two-byte-limit (* byte-limit byte-limit))

; Bytecodes: for compiler and interpreter

; Instruction specification is 
; (op . args)
; OP may be a name or a list of names
; ARGS are

;  byte                   - A byte used for some random purpose
;  two-bytes              - ditto, but two bytes
;  nargs                  - number of arguments on the stack
;  two-byte-nargs         - ditto, but two bytes
;  stack-index            - A one-byte index into the stack
;  two-byte-stack-index   - ditto, but two bytes
;  in-register            - A one-byte index into the stack for an input parameter
;  out-register           - ditto, but for the output location
;  var-registers          - variable number of input registers (1st byte is the # of registers)
;  index                  - A index into some stob
;  two-byte-index         - ditto, but two bytes
;  literal      - a one-byte value
;  offset       - two bytes giving an offset into the current instruction stream
;  offset-      - same thing, negative offset
;  stob         - a byte specifying a type for a stored object
;  env-data     - environment specification with one-byte values
;  big-env-data - environment specification with two-byte values
;  moves-data   - specification of stack shuffle moves
;  big-moves-data - specification of stack shuffle moves
;  cont-data    - cont-data specification
;  protocol     - protocol specification
;  0 1 2 ...    - the number of non-instruction-stream arguments (some
;                 instructions take a variable number of arguments; the first
;                 number is the argument count implemented by the VM)
;  +            - any number of additional arguments are allowed

; - all instructions defined with define-primitive must have an out-in-register as first arg, even if they just return unspecific


(define-syntax define-instruction-set
  (lambda (form rename compare)
    (let ((data (do ((data (reverse (cdr form)) (cdr data))
		     (new '() (let ((next (car data)))
				(if (pair? (car next))
				    (append (map (lambda (op)
						   (cons op (cdr next)))
						 (car next))
					    new)
				    (cons next new)))))
		    ((null? data) new)))
	  (spec-size (lambda (spec)
	  	       (case spec
        		 ((env-data big-env-data moves-data big-moves-data cont-data protocol var-registers)
         		   #f) ; cannot tell the size of these
        		 ((byte nargs stack-index out-register in-register index literal stob)
         		   1)
        		 ((two-bytes two-byte-nargs two-byte-stack-index two-byte-index offset offset-)
         		   2)                 
        	         (else
         		   0)))))
      `(begin (define-enumeration op
		,(map car data))
	      (define opcode-arg-specs
		'#(,@(map cdr data)))
	      (define opcode-sizes
	        '#(,@(map (lambda (op+specs)
	        	    (let loop ((specs (cdr op+specs)) (size 0))
	        	      (cond ((null? specs) 
	        	             (+ size 1)) ; include the opcode in the size
	        	            ((eq? (spec-size (car specs)) #f)
	        	             0) ; variable sized opcode
	        	            (else
	        	             (loop (cdr specs) (+ size (spec-size (car specs))))))))     
	        	    data)))
	      (define opcode-out-registers
	        '#(,@(map (lambda (op+specs)
	                    (let loop ((specs (cdr op+specs)) (offset 0))
	                      (cond ((null? specs)
	                      	     -1) ; no out-register
	                      	    ((eq? (car specs) 'out-register)
	                      	     offset)
	        	            ((eq? (spec-size (car specs)) #f)
	        	             -1) ; variable-sized argument
	                      	    (else
	                      	     (loop (cdr specs) (+ offset (spec-size (car specs))))))))
	                   data)))))))

; Instructions marked *EXP* are experimental and are not normally used by
; byte-code compiler.

(define-instruction-set
  (protocol       	protocol)      ; first opcode in a procedure, never actually
				 ; executed

  (integer-literal 	out-register literal) ; optimization for one-byte integers (also
				         ; used in the closed-compiled +, *)

  (global     		out-register index two-byte-index)   ; first is template (index from continuation up), second within template
  (set-global!     	out-register in-register index two-byte-index) ; first is template, second within template 

  (make-flat-env  	out-register env-data)      ; make new environment from env-data
  (make-big-flat-env 	out-register big-env-data) ; same, but with two-byte size and offsets

  ; the following four emitted from the byte-code optimizer, for the
  ; benefit of the native-code compiler
  (env-set! 		out-register in-register stack-index index 1)             ; set environment slot (not tested in in-register version)
  (big-env-set! 	out-register in-register two-byte-stack-index two-byte-index 1)
  ;(template-ref 	stack-index index) ; same thing as stack-indirect
  ;(big-template-ref 	two-byte-stack-index two-byte-index) ; same thing as stack-indirect

  (make-flat-closure 	out-register two-bytes)  ; create flat closure
  
  (push-registers 	byte)          ; reserve stack space for registers
  (push 		in-register 1) ; push register onto stack (above register window)
  (push-false)			       ; a common combination
  (pop 			out-register)  ; pop top of stack into register
  (pop-n		two-bytes)     ; remove the top N values from the stack
  (push-n	  	two-bytes)     ; allocate space for N values on stack
  
  (move                 out-register in-register 1) ; copy from in to out (replaces old stack-set!)
  
  (register-indirect     out-register in-register index)
  (big-register-indirect out-register in-register two-byte-index)

  (stack-shuffle! 	moves-data)	 ; shuffle stack elements around
  (big-stack-shuffle! 	big-moves-data)	 ; shuffle stack elements around with two-byte offsets

  (current-cont 	out-register)	 ; copy *cont* to out-register, use WITH-CONTINUATION
			         ; to use copied continuation
  (cont-data      	cont-data)	 ; continuation data; never executed

  ;; Different ways to call procedures
  (call     		offset in-register nargs 1 +)   ; in-register argument is the procedure to call,
				                        ; offset is to return pointer
  (tail-call 		in-register nargs 1 +)          ; same, no return pointer, moves arguments
  (big-call offset 	in-register two-byte-nargs 1 +) ; ditto, nargs counts are two bytes
  
  (register-call           offset in-register var-registers) ; in-register is the procedure, var-registers holds the parameters
  (register-tail-call      in-register var-registers)        ; ditto
  (safe-register-tail-call in-register var-registers)        ; same as register-tail, but prevents conflicts when moving the arguments (see call.scm)

  (known-tail-call 	 in-register nargs two-bytes byte 1 +) ; byte = 1 says n-ary, 0 says fixed arity, in-register is the proc
  (known-call            offset in-register nargs byte 1 +) ; like CALL, but no protocol conversion
  (big-known-call offset in-register two-byte-nargs byte 1 +) ; ditto, nargs count are two bytes

  (poll			out-register)            ; returns only unspecific, but this way it needs no special treatment from the compiler
  (apply 		offset in-register in-register two-byte-nargs 2 +) ; offset, procedure, rest-list, stack-nargs. stack=non-list-args   
  (closed-apply 2 +)		 ; arguments are as for Scheme's APPLY, with
				 ; the number of non-list arguments pushed on
  				 ; the top of the stack
  (with-continuation    in-register in-register)  ; first arg is cont, second is procedure

  ;; Three different ways to return from calls
  (return in-register 1)	 ; return one value
  (values two-bytes +)		 ; values are on stack, count is next two bytes
  (closed-values +)		 ; values are on stack, count is pushed on stack

  ;; Six different ways to jump
  (goto-template 	two-byte-index)		 ; jump to another template (*EXP*)
				 ; does not poll for interrupts
  (call-template 	offset index two-byte-index nargs)
				 ; call a template instead of a procedure
				 ; nargs is needed for interrupt handling
  (jump-if-false 	offset in-register 1)	 ; boolean in register


  ;; conditional jump; the offset is the jump target
  (test-op+jump-if-false offset instr instr)

  (jump          	offset)
  (jump-back     	offset-)	 ; same, but subtract the offset
  (computed-goto 	in-register byte offset 1)	 ; jump using delta specified by in-register
				                 ; defaults to instruction after deltas (*EXP*) (not tested in register version!)

  ;; For the closed-compiled definitions of n-ary arithmetic functions.
  ;; The opcode sequences used are:
  ;;       binary-reduce1 (binary-op 0 0 1) binary-reduce2 (return 0)
  ;; and
  ;;       binary-comparison-reduce1 (binary-op 2 0 1) binary-comparison-reduce2 (return 2)
  ((binary-reduce1 binary-reduce2 binary-comparison-reduce1 binary-comparison-reduce2))

  ;; Scalar primitives
  (eq? 			out-register in-register in-register 2)

  ((number? integer? rational? real? complex? exact?) out-register in-register 1)  
  ((exact->inexact inexact->exact) out-register in-register 1)
  
  ((+ *)         	out-register in-register in-register 2 0 1 +)
  ((- /)         	out-register in-register in-register 2 1)
  ((= < > <= >=) 	out-register in-register in-register 2 +)  
  ((quotient remainder) out-register in-register in-register 2)
  ((floor numerator denominator
     real-part imag-part
     exp log sin cos tan asin acos sqrt
     angle magnitude) 
   			out-register in-register 1)
  (atan1 		out-register in-register 1)
  (atan2 		out-register in-register in-register 2)
  ((make-polar make-rectangular) out-register in-register in-register 2)    
  (bitwise-not 		out-register in-register 1)
  (bit-count   		out-register in-register 1)
  ((bitwise-and bitwise-ior bitwise-xor) out-register in-register in-register 2)
  (arithmetic-shift 	out-register in-register in-register 2)
  (char?            	out-register in-register 1)
  ((char=? char<?)  	out-register in-register in-register 2)    
  ((scalar-value->char char->scalar-value scalar-value?) out-register in-register 1)  
  (eof-object? 		out-register in-register 1)

  ;; Data manipulation
  (stored-object-has-type? out-register in-register stob 1)
  (stored-object-length out-register in-register stob 1)

  (make-stored-object 	out-register stob var-registers) ; variable number of stob elements
  (closed-make-stored-object stob)	; size pushed on stack, result also on stack
  (stored-object-ref  	out-register in-register stob index 1)
  (stored-object-set! 	out-register in-register in-register stob index byte 2)	; byte = 0
  					; means not to log in the proposal

  (make-vector-object 	out-register in-register in-register stob 2)			; size + init
  ; If the byte = 0 then do not log in the current proposal
  (stored-object-indexed-ref  out-register in-register in-register stob byte 2)	; vector + offset
  (stored-object-indexed-set! out-register in-register in-register in-register stob byte 3)	; vector + offset + value

  (make-double out-register)

  (make-byte-vector   	out-register in-register in-register 2)
  (byte-vector-length 	out-register in-register 1)
  (byte-vector-ref    	out-register in-register in-register 2)
  (byte-vector-set!   	out-register in-register in-register in-register 3)
  (make-unmovable-byte-vector  out-register in-register in-register 2)

  (make-string        	out-register in-register in-register 2)
  (string-length      	out-register in-register 1)
  (string-ref         	out-register in-register in-register 2)
  (string-set!        	out-register in-register in-register in-register 3)
  (copy-string-chars! 	out-register in-register in-register in-register in-register in-register 5)

  (intern 		out-register in-register 1)
                     
  (location-defined? 	out-register in-register 1)
  (set-location-defined?! out-register in-register in-register 2)
  ((immutable? make-immutable!) out-register in-register 1)

  ;; channels (unbuffered, non-blocking I/O)
  (open-channel        	out-register in-register in-register in-register in-register 4)
  (close-channel       	out-register in-register 1)
  (channel-maybe-read  	out-register in-register in-register in-register in-register in-register 5)
  (channel-maybe-write 	out-register in-register in-register in-register in-register 4)
  (channel-parameter   	out-register in-register 1)
  (channel-ready?      	out-register in-register 1)
  (channel-abort       	out-register in-register 1)             ; stop channel operation
  (open-channels-list  	out-register)		; return a list of the open channels

  ;; weak-pointers
  (make-weak-pointer 	out-register in-register 1)

  ;; Optimistic concurrency
  (current-proposal          out-register)
  (set-current-proposal!     out-register in-register 1)
  (maybe-commit              out-register)
  (stored-object-logging-ref out-register in-register stob index 1)
  (copy-bytes!               out-register in-register in-register in-register in-register in-register byte 5)	; byte = 0 -> don't log
  (byte-vector-logging-ref   out-register in-register in-register 2)
  (byte-vector-logging-set!  out-register in-register in-register in-register 3)

  ;; Misc
  ((unassigned unspecific) out-register)
  (trap  		out-register in-register 1)	; raise exception
  (false 		out-register)		; return #f (for bootstrapping)
  (eof-object 		out-register)         ; hard to get otherwise
  (write-image-low 	out-register in-register in-register in-register in-register 4)
  (collect 		out-register)
  (string-hash 		out-register in-register 1) ; used by the static linker for the initial table
  (add-finalizer! 	out-register in-register in-register 2)
  (memory-status 	out-register in-register in-register 2)
  (find-all 		out-register in-register 1)	                ; makes a vector of all objects of a given type
  (find-all-records 	out-register in-register 1)          ; makes a vector of all records of a given type
  (current-thread 	out-register)
  (set-current-thread! 	out-register in-register 1)
  (session-data 	out-register)                ; session specific data
  (set-session-data! 	out-register in-register 1)
  (set-exception-handlers! out-register in-register 1)
  (set-interrupt-handlers! out-register in-register 1)
  (set-enabled-interrupts! out-register in-register 1)
  (schedule-interrupt 	out-register in-register 1)
  (wait		 	out-register in-register in-register 2)                      ; do nothing until something happens
  (lookup-shared-binding out-register in-register in-register 2)
  (undefine-shared-binding out-register in-register in-register 2)
  (find-undefined-imported-bindings out-register)
  (time 		out-register in-register in-register 2)
  (system-parameter 	out-register in-register 1)
  (vm-extension 	out-register in-register in-register 2)		; access to extensions of the virtual machine
  
  ; for use by the VM only, not generated by the compiler
  (return-from-exception)
  (return-from-native-exception)  
  (resume-interrupted-opcode-to-byte-code)
  (resume-interrupted-call-to-native-code)
  (resume-native-poll)
  
  ; foreign function interface
  ; These opcodes must have the same length, so calling back into Scheme from C works. (see big/callback.scm)  
  ; The easiest way to do this is to have all parameters on the stack
  (call-external-value 1 +)   ; all input on stack, result on stack as well
  (call-external-value-2 1 +) ; same here  
  (return-from-callback 2)    ; both parameters on stack, (fake-)returnvalue too
  
  ;; Unnecessary primitives
  (string=?             out-register in-register in-register 2)
  (reverse-list->string out-register in-register in-register 2)
  (assq                 out-register in-register in-register 2)
  (unassigned-check     out-register in-register 1) ; copies input to output or raises exception
  (record-type<=?       out-register in-register in-register 2)
  ; If the byte = 0 then do not log in the current proposal
  (checked-record-ref   out-register in-register in-register in-register index 3)
  (checked-record-set!  out-register in-register in-register in-register in-register index 4)

  (char->utf  in-register in-register in-register in-register in-register 5) ; no out-reg, as multiple values are returned 
  (char->utf! in-register in-register in-register in-register in-register 5) ; no out-reg, as no value is returned

  (utf->char  in-register in-register in-register in-register 4)
  (utf->char! in-register in-register in-register in-register 4)

  ;; ports (buffered I/O) - these are all unnecessary
  ;; if the port argument is false, get port from dynamic environment
  ((read-byte peek-byte) out-register in-register 1)
  (write-byte            out-register in-register in-register 2)

  ((read-char peek-char) out-register in-register 1)
  (write-char            out-register in-register in-register 2)

  (os-error-message 	 out-register in-register 1)

  ;; For writing informative messages when debugging
  (message 		 out-register in-register 1))

(define-enumeration interrupt
  (alarm           ; order matters - higher priority first
   keyboard

   ;; "Major" means the collector made a maximal effort to reclaim
   ;; memory; everything else is "minor".
   post-minor-gc post-major-gc ; handler is passed a list of finalizers
   i/o-completion  ; handler is passed channel, error flag and status
   os-signal
   external-event  ; handler is passed event type uid
   ))

; Possible problems

(define-enumeration exception
  (unassigned-local
   undefined-global
   unbound-global
   bad-procedure
   wrong-number-of-arguments
   wrong-type-argument
   immutable-argument
   arithmetic-overflow
   index-out-of-range
   heap-overflow
   out-of-memory
   cannot-open-channel
   channel-os-index-already-in-use
   closed-channel
   buffer-full/empty
   unimplemented-instruction
   trap
   proceeding-after-exception
   bad-option
   unbound-external-name
   too-many-arguments-to-external-procedure
   too-many-arguments-in-callback
   callback-return-uncovered
   extension-exception
   extension-return-error
   os-error
   gc-protection-mismatch
   no-current-proposal
   native-code-not-supported
   illegal-exception-return

   ;; these only come from external code
   external-error
   external-assertion-violation
   external-os-error
   ))

; Used by (READ-BYTE) and (WRITE-BYTE) to get the appropriate ports from
; the fluid environment.

(define-enumeration current-port-marker
  (current-input-port
   current-output-port))

;----------------
; Call and return protocols
;
; Protocols 0..maximum-stack-args are just the number of arguments sitting on
; the stack.

(define maximum-stack-args 63)

(define *last-protocol* maximum-stack-args)

(define (next-protocol)
  (set! *last-protocol* (+ *last-protocol* 1))
  *last-protocol*)

; The next two bytes gives the expected number of arguments.

(define two-byte-nargs-protocol      (next-protocol))

; Used for all n-ary procedures.  The next two bytes gives the minimum
; number of arguments.

(define two-byte-nargs+list-protocol (next-protocol))

; Drop any and all arguments on the floor.  The compiler doesn't use this
; for procedures, but does generate it for continuations.

(define ignore-values-protocol (next-protocol))

; Receive one value in a register. The next byte is the output register
; in the target's register frame. Used for continuations with one value.

(define register-protocol (next-protocol))

; Real protocol is at the end of the code vector, along with the required
; stack size:
;   ... real-protocol stack-size0 stack-size1
; This stuff has to be at the end of the code vector because the necessary stack
; size is not determined until after the code vector has been assembled.

(define big-stack-protocol (next-protocol))

; The rest are used only for the definitions of various Scheme primitives.

; For VECTOR, RECORD, VALUES, EXTERNAL-CALL, APPLY
; Next byte is the minimum number of arguments (1 for EXT-CALL, 2 for APPLY,
; 0 for the rest).
; Stack = arg0 arg1 ... argN rest-list N+1 total-arg-count
; The first two arguments are always on the stack.

(define args+nargs-protocol (next-protocol))

; Followed by four bytes: the offsets of code for the 3+, 0, 1, and 2 arg cases.
; A zero indicates that the primitive doesn't accept that number of arguments.
; If there are fewer than three arguments they are all on the stack.  In the
; 3+ case the setup is the same as args+nargs above (it's first so that it can
; share code in the VM with args+nargs).

(define nary-dispatch-protocol (next-protocol))

; The following is used to mark continuations created for the first argument
; to CALL-WITH-VALUES when the second argument is not a LAMBDA expression.
; The continuation contains a single value, the procedure to be called on the
; values returned by the first argument.

(define call-with-values-protocol (next-protocol))

; Used to mark the continuation at the bottom of the stack cash.

(define bottom-of-stack-protocol (next-protocol))

; Native protocols are the same, except with the high bit set.

(define native-protocol-mask #x80)

;----------------
; The number of stack slots available to each procedure by default.
; Procedures that need more than this must use one of the two-byte-nargs
; protocols.  All of these are given in terms of descriptors.

(define default-stack-space 64)

; The maximum number of arguments that can be passed to EXTERNAL-CALL.
; This is determined by the C procedure `external_call()'.

; This leaves space for the non-argument stuff on the stack---see
; external-call.scm.  Note that Mike isn't quite sure this is right.
(define maximum-external-call-args (- default-stack-space 5))

(define continuation-stack-size 4)  ; header + continuation + pc + code

(define available-stack-space 8000) ; how much stack space is available for
                                    ; any one procedure

; The number of values that the VM adds to continuations.
(define continuation-cells 3)

; Offsets of saved registers in continuations
(define continuation-pc-index   0)
(define continuation-code-index 1)
(define continuation-cont-index 2)

; Offsets in the CONT-DATA instruction
					; -1 -2        frame size
(define gc-mask-size-offset -3)		; -3           gc mask size
					; -4 -5        offset
                                        ; -6 -7        template
(define gc-mask-offset      -8)         ; -8 ...       mask (low bytes first)

; The number of additional values that the VM adds to exception continuations.
(define exception-continuation-cells 5)

; The number of additional values that the VM adds to native exception continuations.
(define native-exception-continuation-cells 4)

; Offsets of saved registers in exception continuations.  Size must come
; first because the VM expects it there.
(define exception-cont-size-index             (+ continuation-cells 0))
(define exception-cont-pc-index               (+ continuation-cells 1))
(define exception-cont-code-index             (+ continuation-cells 2))
(define exception-cont-exception-index        (+ continuation-cells 3))
(define exception-cont-instruction-size-index (+ continuation-cells 4))

(define native-exception-cont-size-index      (+ continuation-cells 0))
(define native-exception-cont-exception-index (+ continuation-cells 1))
(define native-exception-cont-bc-pc-index     (+ continuation-cells 2))
(define native-exception-cont-bc-code-index   (+ continuation-cells 3))

;----------------

; Options for op/time

(define-enumeration time-option
  (run-time
   real-time
   cheap-time     ; cheap (no system call) access to the polling clock
   gc-run-time
   ;current-time
   ))

; Options for op/memory-status

(define-enumeration memory-status-option
  (available
   heap-size
   max-heap-size
   stack-size
   gc-count
   expand-heap!
   pointer-hash
   ))

; The two types of special channels cannot be used for normal I/O.

(define-enumeration channel-status-option
  (closed
   input
   output
   special-input   ; socket accept, ???
   special-output  ; ???
   ))

; Indicies into a port's status word

(define-enumeration port-status-options
  (input
   output
   open-for-input
   open-for-output
   ))

; Parameters that configure a channel

(define-enumeration channel-parameter-option
  (buffer-size crlf?))

; Built-in text encodings

(define-enumeration text-encoding-option
  (us-ascii
   latin-1
   utf-8
   utf-16le utf-16be
   utf-32le utf-32be))

; Options for op/system-parameter

(define-enumeration system-parameter-option
  (host-architecture
   os-string-encoding))

(define-enumeration stob
  (;; D-vector types (traced by GC)
   pair
   symbol
   vector
   closure
   location
   cell
   channel
   port
   ratnum
   record
   continuation
   extended-number
   template
   weak-pointer
   shared-binding
   transport-link-cell

   ;; B-vector types (not traced by GC)
   string        ; = least b-vector type, note that the BIBOP GC knows this in c/bibop/data.h
   byte-vector
   double        ; double precision floating point
   bignum
   ))

; This is here to try to ensure that it is changed when STOB changes.
(define least-b-vector-type (enum stob string))

; (stob predicate constructor . (accessor modifier)*)
; If nothing else, the run-time system and the VM need to agree on
; which slot of a pair is the car and which is the cdr.

(define stob-data
  '((pair pair? cons
      (car set-car!) (cdr set-cdr!))
    (symbol symbol? #f       ; RTS calls op/intern/string->symbol
      (symbol->string))
    (location location? make-location
      (location-id set-location-id!)
      (contents set-contents!))
    (cell cell? make-cell
      (cell-ref cell-set!))
    (closure closure? make-closure
      (closure-template set-closure-template!) (closure-env set-closure-env!))
    (weak-pointer weak-pointer? #f ; make-weak-pointer is an op
      (weak-pointer-ref))
    (shared-binding shared-binding? make-shared-binding
      (shared-binding-name)
      (shared-binding-is-import?)
      (shared-binding-ref shared-binding-set!))
    (port port? make-port
      (port-handler)
      ;; either an integer from the TEXT-ENCODING-OPTION for encodings
      ;; handled by the VM, or a :TEXT-CODEC object for things handled
      ;; purely by the RTS
      (port-text-codec-spec set-port-text-codec-spec!)
      (port-crlf?   set-port-crlf?!)
      (port-status  set-port-status!)
      (port-lock    set-port-lock!)		; used for buffer timestamps
      (port-data    set-port-data!)
      (port-buffer  set-port-buffer!)
      (port-index   set-port-index!)
      (port-limit   set-port-limit!)
      ;; for CR/LF handling
      (port-pending-cr?  set-port-pending-cr?!)
      (port-pending-eof? set-port-pending-eof?!))
    (channel channel? #f
      (channel-status)
      (channel-id)
      (channel-os-index)
      (channel-close-silently?))
    (transport-link-cell transport-link-cell? make-transport-link-cell
      (transport-link-cell-key) ; may never be younger than TLC, hence no mutator
      (transport-link-cell-value set-transport-link-cell-value!)
      (transport-link-cell-tconc set-transport-link-cell-tconc!)
      (transport-link-cell-next set-transport-link-cell-next!))
    ))

